

100 REM *************************************************************
105 REM * Rohde & Schwarz   1GPP Betz       Program  TUNER.BAS      *
110 REM * 31.01.2003  Version 1.0                                   *
115 REM * Program for RF tuner measurement according to IEC 60315-4 *
120 REM *************************************************************
125 REM 50 us preemp gives amp 4.817 at 15 kHz -> usable 20% of FDEV
130 REM 75 us preemp gives amp 7.139 at 15 kHz -> usable 14% of FDEV
135 ON KEY GOSUB 3800
140 SET 2,15: VIEWPORT 0,639,0,399: WINDOW 0,639,0,399
145 SHELL "cd\tuner"
150 Path$="C:\TUNER\RESULTS"
155 SHELL "if not exist "+Path$+"\*.* md "+Path$+" >NUL"
160 Tmp$="C:\TUNER\TMP"
165 SHELL "if not exist "+Tmp$+"\*.* md "+Tmp$+" >NUL"
170 ON ERROR GOSUB 4000
175 OPENI# 1,"TUNER.SET"
180 INPUT# 1,Sml
185 INPUT# 1,Lv
190 INPUT# 1,Freq
195 INPUT# 1,Att
200 INPUT# 1,Lv
205 INPUT# 1,Rmsd
210 INPUT# 1,Pre
215 INPUT# 1,Float
220 INPUT# 1,Thd
225 CLOSE# 1
230 Freq$=STR$(Freq,USING "###.#")+"MHz"
235 Lv$=STR$(Lv,USING "##.##")+"mV"
240 Rmsd$=STR$(Rmsd,USING "###")+"kHz": Rmsd$=CHR$(241)+Rmsd$
245 Fdev$=STR$(.9*Rmsd,USING "###.##")+"kHz": Fdev$=CHR$(241)+Fdev$
250 Pil$=STR$(.09*Rmsd,USING "###.##")+"kHz": Pil$=CHR$(241)+Pil$
255 Pre$=STR$(Pre,USING "##")+CHR$(230)+"s"
260 Precorr15=1/SQR(1+(2*PI*15000*Pre*1E-6)^2): REM preemphasis for 15 kHz
265 Corr=10^(Att/20)
270 IEC OUT Sml,"*rst;:outp on"
275 GOSUB 3830: REM set SML
280 ON ERROR RETURN 
285 UPL GTL B: UPL OUT "disp:act on;:disp:ann off": CLEAR 1: CLEAR 
290 MOVE 130,275: LABEL "Measurement of",2
295 MOVE 120,220: LABEL "FM Radio Tuners",2
300 MOVE 120,170: LABEL "with Audio Analyzer UPL",1
305 MOVE 120,140: LABEL "and Signal Generator SML",1
308 MOVE 250,100: LABEL "Version 1.0"
310 MOVE 95,60: LABEL "Select Test to be performed",1
315 GOSUB 3700: Sk5$="END": Sk6$="FRQ_RESP": Sk7$="THDN_FRQ": Sk8$="THDN_DEV"
320 Sk9$="CRSS_FRQ": Sk10$="CRSS_LEV": Sk11$="CRSS_DEV": Sk12$="->"
325 GOSUB 3600
330 IF St=1 THEN
335 CLEAR : CLEAR 1
340 MOVE 100,150: LABEL "Do you really want to quit?",1
345 MOVE 240,110: LABEL "<Y> <N>",1
350 IF Q$="Y" OR Q$="y" THEN 365
355 IF Q$="N" OR Q$="n" THEN GOTO 285
360 GOTO 350
365 ENDIF 
370 IF Q$="Y" OR Q$="y" THEN PRINT "[2J": CLEAR : SOFTKEY : STOP 
375 IF St=2 THEN St=0: GOSUB 3700: CLEAR : GOTO 1000
380 IF St=3 THEN St=0: GOSUB 3700: CLEAR : GOTO 1200
385 IF St=4 THEN St=0: GOSUB 3700: CLEAR : GOTO 1400
390 IF St=5 THEN St=0: GOSUB 3700: CLEAR : GOTO 1700
395 IF St=6 THEN St=0: GOSUB 3700: CLEAR : GOTO 1900
400 IF St=7 THEN St=0: GOSUB 3700: CLEAR : GOTO 2400
405 IF St=8 THEN St=0: GOTO 415
410 All=0: IF Ret=1 THEN 335 ELSE 330
415 GOSUB 3700: Sk5$="<-": Sk6$="S/N_LEV": Sk7$="IN/OUT": Sk8$="PIL_SUPP"
420 Sk9$="": Sk10$="ALL": Sk11$="RECALL": Sk12$="SETUP": GOSUB 3600
425 IF St=1 THEN St=0: GOTO 315
430 IF St=2 THEN St=0: GOSUB 3700: CLEAR : GOTO 2700
435 IF St=3 THEN St=0: GOSUB 3700: CLEAR : GOTO 3000
440 IF St=4 THEN St=0: GOSUB 3700: CLEAR : GOTO 3400
445 IF St=6 THEN St=0: GOSUB 3700: All=1: GOTO 465
450 IF St=7 THEN St=0: GOSUB 3700: GOSUB 11000: GOTO 560
455 IF St=8 THEN St=0: GOSUB 3700: GOSUB 4000: GOTO 230
460 All=0: IF Ret=1 THEN 335 ELSE 425
465 IF Brk=1 THEN Brk=0: GOTO 285
470 UPL GTL B: GOSUB 1000
475 IF Brk=1 THEN Brk=0: GOTO 285
480 UPL GTL B: GOSUB 1200
485 IF Brk=1 THEN Brk=0: GOTO 285
490 UPL GTL B: GOSUB 1400
495 IF Brk=1 THEN Brk=0: GOTO 285
500 UPL GTL B: GOSUB 1700
505 IF Brk=1 THEN Brk=0: GOTO 285
510 UPL GTL B: GOSUB 1900
515 IF Brk=1 THEN Brk=0: GOTO 285
520 UPL GTL B: GOSUB 2400
525 IF Brk=1 THEN Brk=0: GOTO 285
530 UPL GTL B: GOSUB 2700
535 IF Brk=1 THEN Brk=0: GOTO 285
540 UPL GTL B: GOSUB 3000
545 IF Brk=1 THEN Brk=0: GOTO 285
550 UPL GTL B: GOSUB 3400
555 IF Brk=1 THEN Brk=0: GOTO 285
560 PRINT "[2J": CLEAR 
565 PRINT 
570 PRINT 
575 PRINT TAB(10);"MEASUREMENT OF FM RADIO TUNER WITH AUDIO ANALYZER UPL"
580 PRINT 
585 PRINT 
590 PRINT TAB(10);"Measurement results:"
595 PRINT TAB(12);"Audio level Left @ 1kHz @ 90%RMSD:        ";Lft$
600 PRINT TAB(12);"Audio level Right @ 1kHz @ 90%RMSD:       ";Rgt$
605 PRINT 
610 PRINT TAB(12);"Maximum Signal/Noise ratio A wtd.:        ";Snmax$
615 PRINT TAB(12);"RF level for 50 dB S/N A wtd.:            ";Snr50$
620 PRINT TAB(12);"RF level for 40 dB S/N A wtd.:            ";Sn40$
625 PRINT TAB(12);"RF level for 30 dB S/N A wtd.:            ";Sn30$
630 PRINT 
635 PRINT TAB(12);"Sensitivity for Stereo switching:         ";Stereoon$
640 PRINT 
645 PRINT TAB(12);"Pilot suppression:                        ";Pilsup$
650 PRINT TAB(12);"Minimum pilot or spurious suppression:    ";Maxsup$
655 OPENO# 1,Tmp$+"\results.tmp"
660 PRINT# 1,DATE$
665 PRINT# 1,TIME$
670 PRINT# 1,Lft$
675 PRINT# 1,Rgt$
680 PRINT# 1,Snmax$
685 PRINT# 1,Snr50$
690 PRINT# 1,Sn40$
695 PRINT# 1,Sn30$
700 PRINT# 1,Stereoon$
705 PRINT# 1,Pilsup$
710 PRINT# 1,Maxsup$
715 CLOSE# 1
720 GOSUB 3700: Sk5$="BACK": Sk6$="": Sk7$="": Sk8$="VIEW"
725 Sk9$="": Sk10$="SAVE": Sk11$="": Sk12$="REPORT": GOSUB 3600
730 IF St=1 THEN St=0: GOTO 285
735 IF St=4 THEN St=0: GOTO 755
740 IF St=6 THEN St=0: GOSUB 10000: GOTO 560
745 IF St=8 THEN St=0: GOSUB 3700: GOSUB 8000: CLEAR : GOTO 285
750 GOTO 730
755 UPL OUT "MMEM:LOAD:STAT 4,'"+Tmp$+"\F_RES.PCX'"
760 GOSUB 3700: Sk5$="BACK": Sk6$="": Sk7$="": Sk8$="NEXT": GOSUB 3600
770 IF St=1 THEN St=0: GOTO 560
775 IF St=4 THEN St=0: GOTO 790
780 GOTO 770
790 UPL OUT "MMEM:LOAD:STAT 4,'"+Tmp$+"\THDN_FRQ.PCX'"
795 GOSUB 3700: Sk5$="BACK": Sk6$="": Sk7$="": Sk8$="NEXT": GOSUB 3600
800 IF St=1 THEN St=0: GOTO 560
805 IF St=4 THEN St=0: GOTO 815
810 GOTO 800
815 UPL OUT "MMEM:LOAD:STAT 4,'"+Tmp$+"\THDN_DEV.PCX'"
820 GOSUB 3700: Sk5$="BACK": Sk6$="": Sk7$="": Sk8$="NEXT": GOSUB 3600
825 IF St=1 THEN St=0: GOTO 560
830 IF St=4 THEN St=0: GOTO 840
835 GOTO 825
840 UPL OUT "MMEM:LOAD:STAT 4,'"+Tmp$+"\CRSS_FRQ.PCX'"
845 GOSUB 3700: Sk5$="BACK": Sk6$="": Sk7$="": Sk8$="NEXT": GOSUB 3600
850 IF St=1 THEN St=0: GOTO 560
855 IF St=4 THEN St=0: GOTO 865
860 GOTO 850
865 UPL OUT "MMEM:LOAD:STAT 4,'"+Tmp$+"\CRSS_LEV.PCX'"
870 GOSUB 3700: Sk5$="BACK": Sk6$="": Sk7$="": Sk8$="NEXT": GOSUB 3600
875 IF St=1 THEN St=0: GOTO 560
880 IF St=4 THEN St=0: GOTO 890
885 GOTO 875
890 UPL OUT "MMEM:LOAD:STAT 4,'"+Tmp$+"\CRSS_DEV.PCX'"
895 GOSUB 3700: Sk5$="BACK": Sk6$="": Sk7$="": Sk8$="NEXT": GOSUB 3600
900 IF St=1 THEN St=0: GOTO 560
905 IF St=4 THEN St=0: GOTO 915
910 GOTO 900
915 UPL OUT "MMEM:LOAD:STAT 4,'"+Tmp$+"\SN_LEV.PCX'"
920 GOSUB 3700: Sk5$="BACK": Sk6$="": Sk7$="": Sk8$="NEXT": GOSUB 3600
925 IF St=1 THEN St=0: GOTO 560
930 IF St=4 THEN St=0: GOTO 940
935 GOTO 925
940 UPL OUT "MMEM:LOAD:STAT 4,'"+Tmp$+"\IN_OUT.PCX'"
945 GOSUB 3700: Sk5$="BACK": Sk6$="": Sk7$="": Sk8$="NEXT": GOSUB 3600
950 IF St=1 THEN St=0: GOTO 560
955 IF St=4 THEN St=0: GOTO 965
960 GOTO 950
965 UPL OUT "MMEM:LOAD:STAT 4,'"+Tmp$+"\P_SUP.PCX'"
970 GOSUB 3700: Sk5$="BACK": Sk6$="": Sk7$="": Sk8$="NEXT": GOSUB 3600
975 IF St=1 THEN St=0: GOTO 560
980 IF St=4 THEN St=0: GOTO 560
985 GOTO 975
1000 REM * Audio levels and frequency response          *
1005 GOSUB 3830: REM set SML
1010 UPL OUT "MMEM:LOAD:STAT 0,'F_RES.SAC'"
1015 IF Float=0 THEN UPL OUT "INP:LOW GRO"
1020 IF Pre=0 THEN UPL OUT "SOUR:VOLT 2 VPP": REM 100% of FDEV deviation
1025 IF Pre=50 THEN UPL OUT "SOUR:VOLT 1.908056433 VPP": ' 100% dev @ 1kHz
1030 IF Pre=75 THEN UPL OUT "SOUR:VOLT 1.80918362 VPP": ' 100% dev @ 1kHz
1035 UPL OUT "SOUR:FREQ:MODE FIX;:SOUR:FREQ 1KHZ"
1040 UPL OUT "init;*wai
1045 UPL OUT "sens:data?": UPL IN Q$: Lft$=STR$(VAL(Q$),USING "##.###")+"V"
1050 UPL OUT "sens:data2?": UPL IN Q$: Rgt$=STR$(VAL(Q$),USING "##.###")+"V"
1055 UPL OUT "SENS:VOLT:RANG:AUTO OFF"
1060 UPL OUT "SOUR:VOLT "+STR$(2*Precorr15)+"VPP": Dev=.9*Rmsd*Precorr15
1065 UPL OUT "init;*wai
1070 UPL OUT "sens:data?": UPL IN Q$
1075 UPL OUT "SENS:REF:MODE CH1S"
1080 UPL OUT "SOUR:SWE:MODE AUTO;:SOUR:FREQ:MODE SWE1"
1085 UPL OUT "disp:conf p"
1090 UPL GTL U: GOSUB 3700
1095 UPL OUT "init:cont off;*wai
1100 UPL GTL B: UPL GTL G
1105 Prntlev=1: Prntdev=1: GOSUB 4300
1110 UPL OUT "HCOP:DEST PCXF,'"+Tmp$+"\F_RES.PCX'"
1115 UPL OUT "HCOP:ITEM:FRAM WHIT;:HCOP:DEV:COL OFF;:HCOP:WAIT"
1120 IF All=1 THEN CLEAR : CLEAR 1: RETURN 
1125 GOSUB 4500: REM wait for cont
1130 GOTO 285
1200 REM * THD + N versus frequency                     *
1210 GOSUB 3830: REM set SML
1220 UPL OUT "MMEM:LOAD:STAT 0,'THDN_FRQ.SAC'"
1230 IF Float=0 THEN UPL OUT "INP:LOW GRO"
1240 IF Thd=1 THEN UPL OUT "DISP:TRAC:Y:UNIT PCT;SPAC LOG"
1250 UPL OUT "SOUR:VOLT "+STR$(2*Precorr15)+"VPP": Dev=.9*Rmsd*Precorr15
1280 UPL OUT "disp:conf p"
1290 UPL GTL U: GOSUB 3700
1300 UPL OUT "init:cont off;*wai
1310 UPL GTL B: UPL GTL G
1315 Prntlev=1: Prntdev=1: GOSUB 4300
1316 UPL OUT "HCOP:DEST PCXF,'"+Tmp$+"\THDN_FRQ.PCX'"
1317 UPL OUT "HCOP:ITEM:FRAM WHIT;:HCOP:DEV:COL OFF;:HCOP:WAIT"
1320 IF All=1 THEN CLEAR : CLEAR 1: RETURN 
1330 GOSUB 4500: REM wait for cont
1340 GOTO 285
1400 REM * THD + N versus deviation                     *
1410 GOSUB 3830: REM set SML
1420 UPL OUT "MMEM:LOAD:STAT 0,'THDN_DEV.SAC'"
1430 IF Float=0 THEN UPL OUT "INP:LOW GRO"
1440 IF Thd=1 THEN UPL OUT "DISP:TRAC:Y:UNIT PCT;SPAC LOG"
1450 IF Pre=50 THEN
1460 Stp=1.908056433: Star=1000*Stp/45
1470 UPL OUT "SOUR:VOLT:STAR "+STR$(Star)+"MVPP;STOP "+STR$(Stp)+"VPP"
1480 UPL OUT "DISP:TRAC:X:RLEV 9.99406  MV"
1490 ENDIF 
1500 IF Pre=75 THEN
1510 Stp=1.80918362: Star=1000*Stp/45
1520 UPL OUT "SOUR:VOLT:STAR "+STR$(Star)+"MVPP;STOP "+STR$(Stp)+"VPP"
1530 UPL OUT "DISP:TRAC:X:RLEV 9.4762 MV"
1540 ENDIF 
1550 IF Rmsd=50 THEN
1560 UPL OUT "DISP:TRAC:X:RLEV?": UPL IN Q$: Rlev=VAL(Q$)
1570 UPL OUT "DISP:TRAC:X:RLEV "+STR$(Rlev*75/50)+"MV;RIGH 50 VVR"
1580 ENDIF 
1590 UPL OUT "disp:conf p"
1600 UPL GTL U: GOSUB 3700
1610 UPL OUT "init:cont off;*wai
1620 UPL GTL B: UPL GTL G
1625 Prntlev=1: Prntdev=0: GOSUB 4300
1626 UPL OUT "HCOP:DEST PCXF,'"+Tmp$+"\THDN_DEV.PCX'"
1627 UPL OUT "HCOP:ITEM:FRAM WHIT;:HCOP:DEV:COL OFF;:HCOP:WAIT"
1630 IF All=1 THEN CLEAR : CLEAR 1: RETURN 
1640 GOSUB 4500: REM wait for cont
1650 GOTO 285
1700 REM * Crosstalk versus frequency                   *
1710 GOSUB 3830: REM set SML
1720 UPL OUT "MMEM:LOAD:STAT 0,'CRSS_FRQ.SAC'"
1730 IF Float=0 THEN UPL OUT "INP:LOW GRO"
1740 UPL OUT "SOUR:VOLT "+STR$(2*Precorr15)+"VPP": Dev=.9*Rmsd*Precorr15
1770 UPL OUT "disp:conf p"
1780 UPL GTL U: GOSUB 3700
1790 UPL OUT "init:cont off;*wai
1800 UPL OUT "disp:act off"
1810 UPL OUT "DISP:ACT OFF;:DISP:TRAC:FEED 'HOLD';:DISP:TRAC2:FEED 'SENS:DATA'"
1820 UPL OUT "OUTP:SEL CH2;:SENS:REF:MODE CH2M": UPL OUT "disp:act on"
1830 UPL OUT "init:cont off;*wai
1840 UPL GTL B: UPL GTL G
1841 Prntlev=1: Prntdev=1: GOSUB 4300
1842 UPL OUT "HCOP:DEST PCXF,'"+Tmp$+"\CRSS_FRQ.PCX'"
1844 UPL OUT "HCOP:ITEM:FRAM WHIT;:HCOP:DEV:COL OFF;:HCOP:WAIT"
1850 IF All=1 THEN CLEAR : CLEAR 1: RETURN 
1860 GOSUB 4500: REM wait for cont
1870 GOTO 285
1900 REM * Crosstalk versus RF level                    *
1910 GOSUB 3830: REM set SML
1920 UPL OUT "MMEM:LOAD:STAT 0,'CRSS_LEV.SAC'"
1930 IF Float=0 THEN UPL OUT "INP:LOW GRO"
1940 IF Pre=0 THEN UPL OUT "SOUR:VOLT 2 VPP": REM 100% FDEV
1950 IF Pre=50 THEN UPL OUT "SOUR:VOLT 1.9 VPP": REM 95% of FDEV
1960 IF Pre=75 THEN UPL OUT "SOUR:VOLT 1.8 VPP": REM 90% of FDEV
1965 Dev=.9*Rmsd
1970 UPL OUT "init:cont off;*wai"
1980 UPL OUT "SENS:VOLT:RANG:AUTO OFF"
1990 Poin=100: ERASE X(0),Crsl(0),Crsr(0): DIM X(100),Crsl(100),Crsr(100)
2000 FOR I=1 TO Poin: Crsl(I)=9.97E37: Crsr(I)=9.93E37: NEXT 
2010 Fac=100000^(1/(Poin-1))
2020 X(1)=1E-7: FOR I=2 TO 100: X(I)=X(I-1)*Fac: NEXT 
2030 UPL BLOCKOUT X(1),Poin
2040 UPL OUT "trac list"
2050 UPL OUT "disp:conf p"
2060 UPL GTL U: GOSUB 3700
2070 FOR I=1 TO Poin
2080 IEC OUT Sml,"pow "+STR$(X(I)*Corr)+"V"
2090 UPL OUT "init:cont off;*wai"
2100 UPL OUT "sens:data?": UPL IN Q$: W1=VAL(Q$)
2110 UPL OUT "sens:data2?": UPL IN Q$: W2=VAL(Q$)
2120 Crsl(I)=W2/W1
2130 UPL BLOCKOUT Crsl(1),Poin
2140 UPL OUT "trac trac1"
2150 UPL OUT "disp:trac:curv on"
2160 NEXT 
2170 UPL OUT "OUTP:SEL CH2"
2180 FOR I=1 TO Poin
2190 IEC OUT Sml,"pow "+STR$(X(I)*Corr)+"V"
2200 UPL OUT "init:cont off;*wai"
2210 UPL OUT "sens:data?": UPL IN Q$: W1=VAL(Q$)
2220 UPL OUT "sens:data2?": UPL IN Q$: W2=VAL(Q$)
2230 Crsr(I)=W1/W2
2240 UPL BLOCKOUT Crsr(1),Poin
2250 UPL OUT "trac trac2"
2260 UPL OUT "disp:trac2:curv on"
2270 NEXT 
2272 FOR I=1 TO Poin
2274 IF Crsl(I)>.3 OR Crsr(I)>.3 THEN NEXT 
2276 Stereoon=X(I): REM level for more than 10 dB channel separation
2277 Stereoon$=STR$(1E6*Stereoon,USING "###.#")+CHR$(230)+"V"
2280 UPL GTL B: UPL GTL G
2285 Prntlev=0: Prntdev=1: GOSUB 4300
2286 UPL OUT "HCOP:DEST PCXF,'"+Tmp$+"\CRSS_LEV.PCX'"
2287 UPL OUT "HCOP:ITEM:FRAM WHIT;:HCOP:DEV:COL OFF;:HCOP:WAIT"
2290 IF All=1 THEN CLEAR : CLEAR 1: RETURN 
2300 GOSUB 4500: REM wait for cont
2310 GOTO 285
2400 REM * Crosstalk versus deviation                   *
2410 GOSUB 3830: REM set SML
2420 UPL OUT "MMEM:LOAD:STAT 0,'CRSS_DEV.SAC'"
2430 IF Float=0 THEN UPL OUT "INP:LOW GRO"
2440 IF Pre=50 THEN
2450 Stp=1.908056433: Star=1000*Stp/45
2460 UPL OUT "SOUR:VOLT:STAR "+STR$(Star)+"MVPP;STOP "+STR$(Stp)+"VPP"
2470 UPL OUT "DISP:TRAC:X:RLEV 9.99406  MV"
2480 ENDIF 
2490 IF Pre=75 THEN
2500 Stp=1.80918362: Star=1000*Stp/45
2510 UPL OUT "SOUR:VOLT:STAR "+STR$(Star)+"MVPP;STOP "+STR$(Stp)+"VPP"
2520 UPL OUT "DISP:TRAC:X:RLEV 9.4762 MV"
2530 ENDIF 
2540 IF Rmsd=50 THEN
2550 UPL OUT "DISP:TRAC:X:RLEV?": UPL IN Q$: Rlev=VAL(Q$)
2560 UPL OUT "DISP:TRAC:X:RLEV "+STR$(Rlev*75/50)+"MV;RIGH 50 VVR"
2570 ENDIF 
2580 UPL OUT "disp:conf p"
2590 UPL GTL U: GOSUB 3700
2600 UPL OUT "init:cont off;*wai
2610 UPL OUT "disp:act off"
2620 UPL OUT "DISP:ACT OFF;:DISP:TRAC:FEED 'HOLD';:DISP:TRAC2:FEED 'SENS:DATA'"
2630 UPL OUT "OUTP:SEL CH2;:SENS:REF:MODE CH2M": UPL OUT "disp:act on"
2640 UPL OUT "init:cont off;*wai
2650 UPL GTL B: UPL GTL G
2655 Prntlev=1: Prntdev=0: GOSUB 4300
2656 UPL OUT "HCOP:DEST PCXF,'"+Tmp$+"\CRSS_DEV.PCX'"
2657 UPL OUT "HCOP:ITEM:FRAM WHIT;:HCOP:DEV:COL OFF;:HCOP:WAIT"
2660 IF All=1 THEN CLEAR : CLEAR 1: RETURN 
2670 GOSUB 4500: REM wait for cont
2680 GOTO 285
2700 REM * S/N versus RF level                          *
2710 GOSUB 3830: REM set SML
2720 UPL OUT "MMEM:LOAD:STAT 0,'SN_LEV.SAC'"
2730 IF Float=0 THEN UPL OUT "INP:LOW GRO"
2740 IF Pre=0 THEN UPL OUT "SOUR:VOLT 2 VPP": REM 100% FDEV
2750 IF Pre=50 THEN UPL OUT "SOUR:VOLT 1.9 VPP": REM 95% of FDEV
2760 IF Pre=75 THEN UPL OUT "SOUR:VOLT 1.8 VPP": REM 90% of FDEV
2765 Dev=.9*Rmsd
2770 Poin=100: ERASE X(0),Snl(0),Snr(0): DIM X(100),Snl(100),Snr(100)
2780 FOR I=1 TO Poin: Snl(I)=9.97E37: Snr(I)=9.937E37: NEXT 
2790 Fac=100000^(1/(Poin-1))
2800 X(1)=1E-7: FOR I=2 TO 100: X(I)=X(I-1)*Fac: NEXT 
2810 UPL BLOCKOUT X(1),Poin
2820 UPL OUT "trac list"
2830 UPL OUT "disp:conf p"
2840 UPL GTL U: GOSUB 3700
2850 FOR I=1 TO Poin
2860 IEC OUT Sml,"pow "+STR$(X(I)*Corr)+"V"
2870 UPL OUT "init:cont off;*wai"
2880 UPL OUT "sens:data?": UPL IN Q$: Snl(I)=100*10^(VAL(Q$)/20)
2890 UPL OUT "sens:data2?": UPL IN Q$: Snr(I)=100*10^(VAL(Q$)/20)
2900 UPL BLOCKOUT Snl(1),Poin
2910 UPL OUT "trac trac1"
2920 UPL BLOCKOUT Snr(1),Poin
2930 UPL OUT "trac trac2"
2940 UPL OUT "disp:trac:curv on": UPL OUT "disp:trac2:curv on"
2950 NEXT 
2960 UPL GTL B: UPL GTL G
2965 Prntlev=0: Prntdev=1: GOSUB 4300
2966 UPL OUT "HCOP:DEST PCXF,'"+Tmp$+"\SN_LEV.PCX'"
2967 UPL OUT "HCOP:ITEM:FRAM WHIT;:HCOP:DEV:COL OFF;:HCOP:WAIT"
2970 IF All=1 THEN CLEAR : CLEAR 1: RETURN 
2980 GOSUB 4500: REM wait for cont
2990 GOTO 285
3000 REM * IN/OUT measurement                           *
3005 GOSUB 3830: REM set SML
3010 UPL OUT "MMEM:LOAD:STAT 0,'IN_OUT.SAC'"
3015 IF Float=0 THEN UPL OUT "INP:LOW GRO"
3020 IF Pre=0 THEN UPL OUT "SOUR:VOLT 2 VPP": REM 100% FDEV
3025 IF Pre=50 THEN UPL OUT "SOUR:VOLT 1.9 VPP": REM 95% of FDEV
3030 IF Pre=75 THEN UPL OUT "SOUR:VOLT 1.8 VPP": REM 90% of FDEV
3035 Dev=.9*Rmsd
3040 UPL OUT "SENS:VOLT:APER:MODE VAL"
3045 UPL OUT "SENS:VOLT:APER 0.1 S"
3050 Poin=100: ERASE X(0),Lev(0),Mono(0),Stereo(0)
3055 DIM X(Poin),Lev(Poin),Mono(Poin),Stereo(Poin)
3060 FOR I=1 TO Poin: Lev(I)=9.97E37: Mono(I)=9.97E37: Stereo(I)=9.97E37: NEXT 
3065 Fac=100000^(1/(Poin-1))
3070 X(1)=1E-7: FOR I=2 TO 100: X(I)=X(I-1)*Fac: NEXT 
3075 UPL BLOCKOUT X(1),Poin
3080 UPL OUT "trac list"
3085 UPL OUT "disp:conf p"
3090 UPL OUT "init:cont off;*wai"
3095 UPL OUT "sens:data?": UPL IN Q$: Reflev=VAL(Q$)
3100 UPL OUT "SENS:VOLT:RANG:AUTO OFF"
3105 UPL OUT "DISP:TRAC:Y:RLEV "+STR$(Reflev)+"V"
3110 UPL GTL U: GOSUB 3700
3115 Mark=0
3120 FOR I=1 TO Poin
3125 IEC OUT Sml,"pow "+STR$(X(I)*Corr)+"V"
3130 IF Mark=0 AND X(I)>1E-5 THEN UPL OUT "SENS:VOLT:APER:MODE GENT": Mark=1
3135 UPL OUT "init:cont off;*wai"
3140 UPL OUT "sens:data?": UPL IN Q$: Lev(I)=VAL(Q$)
3145 UPL BLOCKOUT Lev(1),Poin
3150 UPL OUT "trac trac1": UPL OUT "disp:trac:curv on"
3155 NEXT 
3160 IEC OUT Sml,"pow "+STR$(X(1)*Corr)+"V"
3165 UPL OUT "SENS:VOLT:APER:MODE VAL"
3170 UPL OUT "SENS:VOLT:APER 0.1 S"
3175 UPL OUT "SOUR:VOLT 1e-20 V"
3180 UPL OUT "DISP:ACT OFF;:DISP:TRAC:FEED 'HOLD';:DISP:TRAC2:FEED 'SENS:DATA'"
3185 UPL OUT "DISP:ACT ON"
3190 FOR I=1 TO Poin
3195 IEC OUT Sml,"pow "+STR$(X(I)*Corr)+"V"
3200 UPL OUT "init:cont off;*wai"
3205 UPL OUT "sens:data?": UPL IN Q$: Stereo(I)=VAL(Q$)
3210 UPL BLOCKOUT Stereo(1),Poin
3215 UPL OUT "trac trac2": UPL OUT "disp:trac2:curv on"
3220 NEXT 
3225 Snmax=20*LOG(Lev(Poin)/Stereo(Poin))/LOG(10)
3227 Snmax$=STR$(Snmax,USING "###.#")+"dB"
3230 IF Snmax<50 THEN Sn50=0: GOTO 3310
3235 FOR I=Poin TO 1 STEP -1
3240 IF 20*LOG(Lev(I)/Stereo(I))/LOG(10)<50 THEN 3250
3245 NEXT 
3250 Sn50=X(I+1): Sn50$=STR$(Sn50*1E3,USING "###.#")+"mV"
3255 IF Sn50<.001 THEN Sn50$=STR$(Sn50*1E6,USING "###.#")+"uV"
3256 IF Sn50<.001 THEN Snr50$=STR$(Sn50*1E6,USING "###.#")+CHR$(230)+"V"
3260 Yo50=20*LOG(Lev(I+1)/Reflev)/LOG(10)
3265 Yu50=20*LOG(Stereo(I+1)/Reflev)/LOG(10)
3270 FOR Z=I TO 1 STEP -1
3275 IF 20*LOG(Lev(Z)/Stereo(Z))/LOG(10)<40 THEN 3285
3280 NEXT 
3285 Sn40=X(Z+1): Sn40$=STR$(Sn40*1E3,USING "###.#")+"mV"
3287 IF Sn40<.001 THEN Sn40$=STR$(Sn40*1E6,USING "###.#")+CHR$(230)+"V"
3290 FOR I=Z TO 1 STEP -1
3295 IF 20*LOG(Lev(I)/Stereo(I))/LOG(10)<30 THEN 3305
3300 NEXT 
3305 Sn30=X(I+1): Sn30$=STR$(Sn30*1E3,USING "###.#")+"mV"
3307 IF Sn30<.001 THEN Sn30$=STR$(Sn30*1E6,USING "###.#")+CHR$(230)+"V"
3310 UPL GTL B: UPL GTL G: GOSUB 5000
3315 IF Sn50>0 THEN Loc=LOG(Sn50/Left)/LOG(10)*.002
3320 IF Sn50>0 THEN SET 2,9: WIDTH 17476: MOVE Loc,Yu50: DRAW Loc,Yo50
3322 IF Sn50=0 THEN 3360
3325 IF Sn50<2E-3 THEN
3330 WIDTH -1: MOVE Loc,Yu50+10: LABEL " S/N>50dB"
3335 MOVE Loc,Yu50+7: LABEL " @"+Sn50$
3340 ELSE 
3345 WIDTH -1: MOVE Loc-1.5E-3,Yu50+10: LABEL " S/N>50dB"
3350 MOVE Loc-1.5E-3,Yu50+7: LABEL " @"+Sn50$
3355 ENDIF 
3360 SET 2,15: WIDTH -1: VIEWPORT 0,639,0,399: WINDOW 0,639,0,399
3365 Prntlev=0: Prntdev=1: GOSUB 4300
3366 UPL OUT "HCOP:DEST PCXF,'"+Tmp$+"\IN_OUT.PCX'"
3367 UPL OUT "HCOP:ITEM:FRAM WHIT;:HCOP:DEV:COL OFF;:HCOP:WAIT"
3370 IF All=1 THEN CLEAR : CLEAR 1: RETURN 
3375 GOSUB 4500: REM wait for cont
3380 GOTO 285
3400 REM * Pilot suppression                            *
3405 GOSUB 3830: REM set SML
3410 UPL OUT "MMEM:LOAD:STAT 0,'P_SUP.SAC'"
3415 IF Float=0 THEN UPL OUT "INP:LOW GRO"
3420 IF Pre=0 THEN UPL OUT "SOUR:VOLT 2 VPP": REM 100% FDEV
3425 IF Pre=50 THEN UPL OUT "SOUR:VOLT 1.9 VPP": REM 95% of FDEV
3430 IF Pre=75 THEN UPL OUT "SOUR:VOLT 1.8 VPP": REM 90% of FDEV
3435 Dev=.9*Rmsd
3440 UPL OUT "SOUR:FREQ 1 KHZ"
3445 UPL OUT "init:cont off;*wai"
3450 UPL OUT "sens:data?": UPL IN Q$
3455 UPL OUT "SENS:REF:MODE CH1S"
3460 UPL OUT "SOUR:VOLT 0 V"
3462 UPL OUT "init:cont off;*wai"
3465 UPL OUT "DISP:TRAC:CURS:MODE N12"
3470 UPL OUT "DISP:TRAC:CURS:POS:MODE MAX1"
3475 UPL OUT "DISP:TRAC:CURS:DATA?": UPL IN W$: W=-VAL(W$)
3476 Maxsup$=STR$(W,USING "###.#")+"dB"
3480 UPL OUT "DISP:TRAC:CURS:POS:MODE VAL"
3485 UPL OUT "DISP:TRAC:CURS:POS "+STR$(19000)+"HZ"
3490 UPL OUT "DISP:TRAC:CURS:DATA?": UPL IN W$: W=-VAL(W$)
3491 Pilsup$=STR$(W,USING "###.#")+"dB"
3492 UPL OUT "DISP:TRAC:CURS:MODE OFF"
3495 UPL OUT "disp:conf p"
3505 UPL GTL G: GOSUB 3700
3510 Prntlev=0: Prntdev=1: GOSUB 4300
3515 UPL OUT "HCOP:DEST PCXF,'"+Tmp$+"\P_SUP.PCX'"
3520 UPL OUT "HCOP:ITEM:FRAM WHIT;:HCOP:DEV:COL OFF;:HCOP:WAIT"
3525 IF All=1 THEN CLEAR : CLEAR 1: RETURN 
3530 GOSUB 4500: REM wait for cont
3535 GOTO 285
3600 REM * Write Softkeys *
3605 Sc$=CHR$(23)+CHR$(21)+CHR$(21)+CHR$(21)+CHR$(21)+CHR$(21)
3610 Sk$=CHR$(23)+CHR$(22)+CHR$(22)
3615 PRINT Sk$;"R1";TAB(10-LEN(Sk5$)/2);Sk5$
3620 PRINT Sk$;"R2";TAB(10-LEN(Sk6$)/2);Sk6$
3625 PRINT Sk$;"R3";TAB(10-LEN(Sk7$)/2);Sk7$
3630 PRINT Sk$;"R4";TAB(10-LEN(Sk8$)/2);Sk8$
3635 PRINT Sk$;"R5";TAB(10-LEN(Sk9$)/2);Sk9$
3640 PRINT Sk$;"R6";TAB(10-LEN(Sk10$)/2);Sk10$
3645 PRINT Sk$;"R7";TAB(10-LEN(Sk11$)/2);Sk11$
3650 PRINT Sk$;"R8";TAB(10-LEN(Sk12$)/2);Sk12$
3655 PRINT "[0;0H"
3660 RETURN 
3700 REM * Erase Softkeys *
3710 Sc$=CHR$(23)+CHR$(21)+CHR$(21)+CHR$(21)+CHR$(21)+CHR$(21)+CHR$(21)
3720 PRINT Sc$+"Q2";TAB(70);"                     "
3730 Sk5$="": Sk6$="": Sk7$="": Sk8$="": Sk9$="": Sk10$="": Sk11$="": Sk12$=""
3740 Sc5$="": Sc6$="": Sc7$="": Sc8$="": Sc9$="": Sc10$="": Sc11$="": Sc12$=""
3750 Sk$=CHR$(23)+CHR$(22)+CHR$(22)
3760 PRINT Sk$;"R1        ": PRINT "R2        "
3770 PRINT "R3        ": PRINT "R4        ": PRINT "R5        "
3780 PRINT "R6        ": PRINT "R7        ": PRINT "R8        "
3790 RETURN 
3800 REM   * Read key *
3805 INKEY Q$
3810 Q=ASC(Q$): St=Q-227: IF St<0 OR St>8 THEN St=0
3815 IF Q$="" THEN Brk=1
3820 ON KEY GOSUB 3800: RETURN 
3825 UPL OUT "INP:LOW GRO"
3830 REM * set SML                                      *
3835 IEC OUT Sml,"stereo:deviation "+STR$(0.9*Rmsd)+"KHZ": REM FDEV=90% RMSD
3840 IF Rmsd=50 THEN IEC OUT Sml,"stereo:pilot:deviation 4.5 KHZ"
3845 IEC OUT Sml,"freq "+STR$(Freq)+"Mhz;pow "+STR$(Lv*Corr)+"MV"
3850 IF Pre=0 THEN IEC OUT Sml,"stereo:audio:preemphasis:stat off"
3855 IF Pre>0 THEN IEC OUT Sml,"stereo:audio:preemphasis:stat on"
3860 IF Pre=50 THEN IEC OUT Sml,"stereo:audio:preemphasis 50us"
3865 IF Pre=75 THEN IEC OUT Sml,"stereo:audio:preemphasis 75us"
3870 IEC OUT Sml,"stereo:stat on;source LREXT"
3875 IEC OUT Sml,"stereo:audio:mode RNEL"
3880 RETURN 
4000 REM *  make tuner setup file                             *
4005 ON ERROR GOTO 4060
4010 OPENI# 1,"TUNER.SET"
4015 INPUT# 1,Sml
4020 INPUT# 1,Lv
4025 INPUT# 1,Freq
4030 INPUT# 1,Att
4035 INPUT# 1,Lv
4040 INPUT# 1,Rmsd
4045 INPUT# 1,Pre
4050 INPUT# 1,Float
4055 INPUT# 1,Thd
4060 CLOSE# 1
4065 ON ERROR RETURN 
4070 CLEAR : CLEAR 1
4075 MOVE 70,330: LABEL "Tuner Program Setup",2
4080 PRINT "[8;10H                                  Range           Value"
4085 PRINT "[10;10HSML GPIB Address                  0...31         ";Sml
4090 PRINT "[11;10HRated Max System Deviation       50/75 kHz       ";Rmsd
4095 PRINT "[12;10HPreemphase                        0/50/75 us     ";Pre
4100 PRINT "[13;10HAttenuation antenna matching      0...20 dB      ";Att
4105 PRINT "[14;10HMeasuring RF Level in mV          0.1...10 mV    ";Lv
4110 PRINT "[15;10HMeasuring Frequency              65...108 MHz    ";Freq
4115 PRINT "[16;10HUPL Input selection        Ground=0 Float=1      ";Float
4120 PRINT "[17;10HTHD+N Display selection        dB=0     %=1      ";Thd
4125 PRINT "[20;10H!! Enter values with RETURN, do not use arrow keys !!"
4130 INPUT "[10;60H";Sml
4135 IF Sml<0 OR Sml>31 THEN 4130
4140 INPUT "[11;60H";Rmsd
4145 IF Rmsd=50 OR Rmsd=75 THEN 4150 ELSE 4140
4150 INPUT "[12;60H";Pre
4155 IF Pre=50 OR Pre=75 OR Pre=0 THEN 4160 ELSE 4150
4160 INPUT "[13;60H";Att
4165 IF Att<0 OR Att>20 THEN 4160
4170 INPUT "[14;60H";Lv
4175 IF Lv<0.1 OR Lv>10 THEN 4170
4180 INPUT "[15;60H";Freq
4185 IF Freq<65 OR Freq>108 THEN 4180
4190 INPUT "[16;60H";Float
4195 IF Float=0 OR Float=1 THEN 4200 ELSE 4190
4200 INPUT "[17;60H";Thd
4205 IF Thd=0 OR Thd=1 THEN 4210 ELSE 4200
4210 OPENO# 1,"TUNER.SET"
4215 PRINT# 1,Sml
4220 PRINT# 1,Lv
4225 PRINT# 1,Freq
4230 PRINT# 1,Att
4235 PRINT# 1,Lv
4240 PRINT# 1,Rmsd
4245 PRINT# 1,Pre
4250 PRINT# 1,Float
4255 PRINT# 1,Thd
4260 CLOSE# 1
4265 ON ERROR GOSUB 4000: RETURN 
4300 REM * write comments into graph                   *
4310 Txt$="RMSD:"+CHR$(241)+RIGHT$(STR$(Rmsd),2)+"kHz"
4320 Txt$=Txt$+" Preemp:"+RIGHT$(STR$(Pre),2)+CHR$(230)+"s"
4325 IF Freq<100 THEN Freq$=STR$(Freq,USING "##.#")+"MHz"
4326 IF Freq>=100 THEN Freq$=STR$(Freq,USING "###.#")+"MHz"
4330 Txt$=Txt$+" RF_Freq:"+Freq$
4335 IF Lv<10 THEN Lev$=STR$(Lv,USING "#.##")+"mV"
4336 IF Lv>=10 THEN Lev$=STR$(Lv,USING "##.##")+"mV"
4340 IF Prntlev=1 THEN Txt$=Txt$+" RF_Lev:"+Lev$
4350 Devi$=STR$(Dev,USING "##.##")+"kHz"
4360 IF Prntdev=1 THEN Txt$=Txt$+" Dev:"+CHR$(241)+Devi$
4370 PRINT "[1;7H"+Txt$
4380 RETURN 
4500 REM * wait for cont and save values               *
4505 Pcx=1: Trc=1: Ep=1
4510 GOSUB 3700: Sk6$="CONT"
4515 IF Ex=1 THEN Sk8$="ABS-SENS"
4520 IF Ep=1 THEN Sk9$="EXP-FILE"
4525 IF Trc=1 THEN Sk10$="TRC-FILE"
4530 IF Pcx=1 THEN Sk11$="PCX-FILE"
4535 Sk12$="PRINTER": GOSUB 3600
4540 IF St=2 THEN
4545 Res=0: Trc=0: Ep=0: Ex=0: Pcx=0: REM no results available
4550 St=0: PRINT "[2J": CLEAR : UPL GTL B: RETURN 
4555 ENDIF 
4560 IF St=8 THEN
4565 GOSUB 3700
4570 UPL OUT "HCOP:DEST PRIN"
4575 St=0: UPL OUT "hcop:wait"
4580 OPENO# 1,"lpt1:": PRINT# 1,CHR$(12): CLOSE# 1
4585 GOTO 4510
4590 ENDIF 
4595 IF Pcx=1 AND St=7 THEN
4600 GOSUB 3700
4605 CLOSE# 1
4610 Picfile=Picfile+1
4615 File$="PIC"+RIGHT$(STR$(Picfile),(LEN(STR$(Picfile))-1))+".PCX"
4620 ON ERROR GOTO 4635
4625 OPENI# 1,Path$+"\"+File$
4630 GOTO 4605
4635 CLOSE# 1
4640 UPL OUT "HCOP:DEST PCXF,'"+Path$+"\"+File$+"'"
4645 UPL OUT "HCOP:DEV:COL OFF"
4650 UPL OUT "HCOP:ITEM:FRAM WHIT"
4655 Pcx=0: St=0: UPL OUT "hcop:wait"
4660 GOTO 4510
4665 ENDIF 
4670 IF Trc=1 AND St=6 THEN
4675 GOSUB 3700
4680 ON ERROR GOTO 4690
4685 UPL OUT "MMEM:STOR:TRAC TR1A,'xyz.xyz'": GOTO 4700
4690 ON ERROR GOTO 4760
4695 UPL OUT "MMEM:STOR:TRAC TRAC,'xyz.xyz'"
4700 CLOSE# 1
4705 Trcfile=Trcfile+1
4710 File$="TRC"+RIGHT$(STR$(Trcfile),(LEN(STR$(Trcfile))-1))+".TRC"
4715 ON ERROR GOTO 4730
4720 OPENI# 1,Path$+"\"+File$
4725 GOTO 4700
4730 CLOSE# 1
4735 UPL OUT "MMEM:STOR:FORM ASC"
4740 ON ERROR GOTO 4750
4745 UPL OUT "MMEM:STOR:TRAC TR1A,'"+Path$+"\"+File$+"'": GOTO 4760
4750 ON ERROR GOTO 4760
4755 UPL OUT "MMEM:STOR:TRAC TRAC,'"+Path$+"\"+File$+"'"
4760 St=0: Trc=0
4765 SHELL "if exist xyz.xyz del xyz.xyz"
4770 GOTO 4510
4775 ENDIF 
4780 IF Ep=1 AND St=5 THEN
4785 GOSUB 3700
4790 ON ERROR GOTO 4860
4795 UPL OUT "MMEM:STOR:TRAC TRAC,'xyz.xyz'"
4800 CLOSE# 1
4805 Expfile=Expfile+1
4810 File$="EXP"+RIGHT$(STR$(Expfile),(LEN(STR$(Expfile))-1))+".EXP"
4815 ON ERROR GOTO 4830
4820 OPENI# 1,Path$+"\"+File$
4825 GOTO 4800
4830 CLOSE# 1
4835 UPL OUT "MMEM:STOR:FORM EXP"
4840 ON ERROR GOTO 4850
4845 UPL OUT "MMEM:STOR:TRAC TR1A,'"+Path$+"\"+File$+"'": GOTO 4860
4850 ON ERROR GOTO 4860
4855 UPL OUT "MMEM:STOR:TRAC TRAC,'"+Path$+"\"+File$+"'"
4860 St=0: Ep=0
4865 SHELL "if exist xyz.xyz del xyz.xyz"
4870 GOTO 4510
4875 ENDIF 
4880 IF Ex=1 AND St=4 THEN
4885 GOSUB 3700
4890 CLOSE# 1
4895 Absfile=Absfile+1
4900 File$="ABS"+RIGHT$(STR$(Absfile),(LEN(STR$(Absfile))-1))+".EXP"
4905 ON ERROR GOTO 4920
4910 OPENI# 1,Path$+"\"+File$
4915 GOTO 4890
4920 CLOSE# 1
4925 SHELL "if exist abscurv.exp copy abscurv.exp "+Path$+"\"+File$
4930 St=0: Ex=0
4935 GOTO 4510
4940 ENDIF 
4945 GOTO 4540
5000 REM * set Window                                   *
5010 UPL OUT "DISP:TRAC:Y:TOP?"
5020 UPL IN W$: Top=VAL(W$)
5030 UPL OUT "DISP:TRAC:Y:BOTT?"
5040 UPL IN W$: Bott=VAL(W$)
5050 UPL OUT "DISP:TRAC:X:LEFT?"
5060 UPL IN W$: Left=VAL(W$)
5070 IF LEFT$(RIGHT$(W$,2),1)="U" THEN Left=Left/1E6
5080 IF LEFT$(RIGHT$(W$,2),1)="M" THEN Left=Left/1E3
5090 UPL OUT "DISP:TRAC:X:RIGH?"
5100 UPL IN W$: Right=VAL(W$)
5110 IF LEFT$(RIGHT$(W$,2),1)="U" THEN Right=Right/1E6
5120 IF LEFT$(RIGHT$(W$,2),1)="M" THEN Right=Right/1E3
5130 'VIEWPORT 272,624,2,226: REM kleines Fenster
5140 VIEWPORT 64,608,2,335: REM grosses Fenster
5150 WINDOW Left,Right,Bott,Top
5160 RETURN 
7510 UPL OUT "DISP:TRAC:CURS:MODE N12"
7525 UPL OUT "DISP:TRAC:CURS:POS:MODE MAX1"
7530 UPL OUT "DISP:TRAC:CURS:DATA?": UPL IN W$: W=VAL(W$)
7550 UPL OUT "DISP:TRAC:CURS:DATA2?": UPL IN W$: W=VAL(W$)
7570 UPL OUT "DISP:TRAC:CURS:POS:MODE VAL"
7600 UPL OUT "DISP:TRAC:CURS:POS "+STR$(Fiec)+"HZ"
7605 UPL OUT "DISP:TRAC:CURS:DATA?": UPL IN W$
8000 REM * report                                       *
8010 REM *  read report values                          *
8020 ON ERROR GOTO 8080
8030 OPENI# 1,Tmp$+"\REPORT.DAT"
8040 INPUT# 1,Dev$
8050 INPUT# 1,Ser$
8060 INPUT# 1,Name$
8070 INPUT# 1,Comment$
8080 CLOSE# 1
8090 ON ERROR RETURN 
8100 CLEAR : CLEAR 1
8110 MOVE 70,330: LABEL "Report information",2
8120 PRINT "[10;10HDevice under Test:       ";Dev$
8130 PRINT "[12;10HSerial no:               ";Ser$
8140 PRINT "[14;10HTested by:               ";Name$
8150 PRINT "[16;10HComment:                 ";Comment$
8160 INPUT "[10;35H";Dev$
8170 INPUT "[12;35H";Ser$
8180 INPUT "[14;35H";Name$
8190 INPUT "[16;35H";Comment$
8200 OPENO# 1,Tmp$+"\REPORT.DAT"
8210 PRINT# 1,Dev$
8220 PRINT# 1,Ser$
8230 PRINT# 1,Name$
8240 PRINT# 1,Comment$
8250 CLOSE# 1
8260 OPENO# 1,"lpt1:"
8270 PRINT# 1,"E"
8280 PRINT# 1,"          MEASUREMENT OF FM RADIO TUNER WITH AUDIO ANALYZER";
8290 PRINT# 1," UPL         1"
8300 PRINT# 1
8310 PRINT# 1
8320 PRINT# 1,TAB(10);"Device under test: ";Dev$
8330 PRINT# 1,TAB(10);"Serial no:         ";Ser$
8340 PRINT# 1,TAB(10);"Tested by:         ";Name$
8350 PRINT# 1,TAB(10);"Comment:           ";Comment$
8360 PRINT# 1,TAB(10);"Date / Time:       ";DATE$;" / ";LEFT$(TIME$,5)
8370 PRINT# 1
8380 PRINT# 1,TAB(10);"System settings:"
8390 PRINT# 1,TAB(12);"Rated Maximum System Deviation RMSD:      ";Rmsd$
8400 PRINT# 1,TAB(12);"Maximum modulation dev. (90% of RMSD):    ";Fdev$
8410 PRINT# 1,TAB(12);"Pilot deviation (9% of RMSD):             ";Pil$
8420 PRINT# 1,TAB(12);"Preemphasis:                              ";Pre$
8430 PRINT# 1,TAB(12);"RF frequency:                             ";Freq$
8440 PRINT# 1,TAB(12);"RF level:                                 ";Lv$
8450 PRINT# 1
8460 PRINT# 1,TAB(10);"Measurement results:"
8470 PRINT# 1,TAB(12);"Audio level Left @ 1kHz @ 90%RMSD:        ";Lft$
8480 PRINT# 1,TAB(12);"Audio level Right @ 1kHz @ 90%RMSD:       ";Rgt$
8490 PRINT# 1
8500 PRINT# 1,TAB(12);"Maximum Signal/Noise ratio A wtd.:        ";Snmax$
8510 PRINT# 1,TAB(12);"RF level for 50 dB S/N A wtd.:            ";Snr50$
8520 PRINT# 1,TAB(12);"RF level for 40 dB S/N A wtd.:            ";Sn40$
8530 PRINT# 1,TAB(12);"RF level for 30 dB S/N A wtd.:            ";Sn30$
8540 PRINT# 1
8550 PRINT# 1,TAB(12);"Sensitivity for Stereo switching:         ";Stereoon$
8560 PRINT# 1
8570 PRINT# 1,TAB(12);"Pilot suppression:                        ";Pilsup$
8580 PRINT# 1,TAB(12);"Minimum pilot or spurious suppression:    ";Maxsup$
8590 PRINT# 1
8600 ON ERROR GOTO 8620
8610 SHELL "copy c:\upl\ref\prnt.def c:\upl\ref\prnt.tmp >nul"
8620 ON ERROR RETURN 
8630 UPL OUT "HCOP:DEST PRIN"
8640 UPL OUT "HCOP:DEV:PRIN 62"
8650 UPL OUT "HCOP:PAGE:LMAR 10"
8660 UPL OUT "HCOP:DEV:RES MED"
8670 UPL OUT "HCOP:PAGE:SCAL:X 1.5;Y 1.5"
8680 UPL OUT "HCOP:PAGE:ORI PORT"
8690 UPL OUT "MMEM:LOAD:STAT 4,'"+Tmp$+"\F_RES.PCX'"
8700 UPL OUT "hcop:wait"
8710 PRINT# 1,CHR$(12)
8720 PRINT# 1,"MEASUREMENT OF FM RADIO TUNER WITH AUDIO ANALYZER UPL";
8730 PRINT# 1,"         2"
8740 PRINT# 1
8750 PRINT# 1,"Device under test: ";Dev$
8760 PRINT# 1
8770 UPL OUT "MMEM:LOAD:STAT 4,'"+Tmp$+"\THDN_FRQ.PCX'"
8780 UPL OUT "hcop:wait"
8790 PRINT# 1
8800 UPL OUT "MMEM:LOAD:STAT 4,'"+Tmp$+"\THDN_DEV.PCX'"
8810 UPL OUT "hcop:wait"
8820 PRINT# 1,CHR$(12)
8830 PRINT# 1,"MEASUREMENT OF FM RADIO TUNER WITH AUDIO ANALYZER UPL";
8840 PRINT# 1,"         3"
8850 PRINT# 1
8860 PRINT# 1,"Device under test: ";Dev$
8870 PRINT# 1
8880 UPL OUT "MMEM:LOAD:STAT 4,'"+Tmp$+"\CRSS_FRQ.PCX'"
8890 UPL OUT "hcop:wait"
8900 PRINT# 1
8910 UPL OUT "MMEM:LOAD:STAT 4,'"+Tmp$+"\CRSS_LEV.PCX'"
8920 UPL OUT "hcop:wait"
8930 PRINT# 1,CHR$(12)
8940 PRINT# 1,"MEASUREMENT OF FM RADIO TUNER WITH AUDIO ANALYZER UPL";
8950 PRINT# 1,"         4"
8960 PRINT# 1
8970 PRINT# 1,"Device under test: ";Dev$
8980 PRINT# 1
8990 UPL OUT "MMEM:LOAD:STAT 4,'"+Tmp$+"\CRSS_DEV.PCX'"
9000 UPL OUT "hcop:wait"
9010 PRINT# 1
9020 UPL OUT "MMEM:LOAD:STAT 4,'"+Tmp$+"\SN_LEV.PCX'"
9030 UPL OUT "hcop:wait"
9040 PRINT# 1,CHR$(12)
9050 PRINT# 1,"MEASUREMENT OF FM RADIO TUNER WITH AUDIO ANALYZER UPL";
9060 PRINT# 1,"         5"
9070 PRINT# 1
9080 PRINT# 1,"Device under test: ";Dev$
9090 PRINT# 1
9100 UPL OUT "MMEM:LOAD:STAT 4,'"+Tmp$+"\IN_OUT.PCX'"
9110 UPL OUT "hcop:wait"
9120 PRINT# 1
9130 UPL OUT "MMEM:LOAD:STAT 4,'"+Tmp$+"\P_SUP.PCX'"
9140 UPL OUT "hcop:wait"
9150 PRINT# 1,"E"
9160 CLOSE# 1
9170 ON ERROR GOTO 9190
9180 SHELL "copy c:\upl\ref\prnt.tmp c:\upl\ref\prnt.def >nul"
9190 ON ERROR RETURN 
9200 RETURN 
10000 REM *   REM Save measured values                   *
10010 CLEAR 1: CLEAR : GOSUB 3700
10020 ON ERROR GOTO 10080
10030 OPENI# 1,Tmp$+"\REPORT.DAT": REM read report values
10040 INPUT# 1,Dev$
10050 INPUT# 1,Ser$
10060 INPUT# 1,Name$
10070 INPUT# 1,Comment$
10080 CLOSE# 1
10090 ON ERROR RETURN 
10100 CLEAR : CLEAR 1
10110 MOVE 70,330: LABEL "Report information",2
10120 PRINT "[10;10HDevice under Test:       ";Dev$
10130 PRINT "[12;10HSerial no:               ";Ser$
10140 PRINT "[14;10HTested by:               ";Name$
10150 PRINT "[16;10HComment:                 ";Comment$
10160 INPUT "[10;35H";Dev$
10170 INPUT "[12;35H";Ser$
10180 INPUT "[14;35H";Name$
10190 INPUT "[16;35H";Comment$
10200 OPENO# 1,Tmp$+"\REPORT.DAT"
10210 PRINT# 1,Dev$
10220 PRINT# 1,Ser$
10230 PRINT# 1,Name$
10240 PRINT# 1,Comment$
10250 CLOSE# 1
10260 MOVE 60,110: LABEL "File name for storage of results",1
10270 PRINT "[20;10HFile Name:";
10280 INPUT "[20;35H";File$
10290 ON ERROR GOTO 10350
10300 Savtrc$=Path$+"\"+File$: Sav$=Savtrc$+".res"
10310 OPENI# 1,Sav$
10320 Q$="": PRINT "[22;10HFilename already exists - overwrite <Y> <N> ";
10330 IF Q$="N" OR Q$="n" THEN Q$="": CLOSE# 1: GOTO 10270
10340 IF Q$="Y" OR Q$="y" THEN 10350 ELSE 10330
10350 CLEAR 1: CLEAR : ON ERROR RETURN 
10360 SHELL "copy "+Tmp$+"\REPORT.DAT "+Savtrc$+".REP >nul"
10370 SHELL "copy "+Tmp$+"\RESULTS.TMP "+Savtrc$+".RES >nul"
10380 SHELL "copy "+Tmp$+"\F_RES.PCX "+Savtrc$+".FRQ >nul"
10390 SHELL "copy "+Tmp$+"\THDN_FRQ.PCX "+Savtrc$+".TNF >nul"
10400 SHELL "copy "+Tmp$+"\THDN_DEV.PCX "+Savtrc$+".TND >nul"
10410 SHELL "copy "+Tmp$+"\CRSS_FRQ.PCX "+Savtrc$+".CRF >nul"
10420 SHELL "copy "+Tmp$+"\CRSS_LEV.PCX "+Savtrc$+".CRL >nul"
10430 SHELL "copy "+Tmp$+"\CRSS_DEV.PCX "+Savtrc$+".CRD >nul"
10440 SHELL "copy "+Tmp$+"\SN_LEV.PCX "+Savtrc$+".SNL >nul"
10450 SHELL "copy "+Tmp$+"\IN_OUT.PCX "+Savtrc$+".IOL >nul"
10460 SHELL "copy "+Tmp$+"\P_SUP.PCX "+Savtrc$+".PIS >nul"
10470 CLEAR 1: CLEAR : ON ERROR RETURN : RETURN 
11000 REM *   REM Read stored values *
11010 CLEAR 1: CLEAR : PRINT "[0;0H"
11020 SHELL "dir "+Path$+"\*.res /od /b"
11030 PRINT "[12;22HFile to be loaded ";: INPUT Mea$
11040 PRINT "[14;22H                                                "
11050 IF LEN(Mea$)>8 THEN 11030
11060 IF LEFT$(RIGHT$(Mea$,4),1)="." THEN Mea$=LEFT$(Mea$,LEN(Mea$-4))
11070 CLOSE# 1
11080 ON ERROR GOTO 11010
11090 Rcl$=Path$+"\"+Mea$
11100 OPENI# 1,Rcl$+".res"
11110 ON ERROR GOTO 11270
11120 INPUT# 1,Dte$: INPUT# 1,Tme$
11130 INPUT# 1,Lft$: INPUT# 1,Rgt$
11140 INPUT# 1,Snmax$: INPUT# 1,Snr50$: INPUT# 1,Sn40$: INPUT# 1,Sn30$
11150 INPUT# 1,Stereoon$: INPUT# 1,Pilsup$: INPUT# 1,Maxsup$
11160 CLOSE# 1
11170 SHELL "copy "+Rcl$+".REP "+Tmp$+"REPORT.DAT >NUL"
11180 SHELL "copy "+Rcl$+".FRQ "+Tmp$+"\F_RES.PCX >nul"
11190 SHELL "copy "+Rcl$+".TNF "+Tmp$+"\THDN_FRQ.PCX >nul"
11200 SHELL "copy "+Rcl$+".TND "+Tmp$+"\THDN_DEV.PCX >nul"
11210 SHELL "copy "+Rcl$+".CRF "+Tmp$+"\CRSS_FRQ.PCX >nul"
11220 SHELL "copy "+Rcl$+".CRL "+Tmp$+"\CRSS_LEV.PCX >nul"
11230 SHELL "copy "+Rcl$+".CRD "+Tmp$+"\CRSS_DEV.PCX >nul"
11240 SHELL "copy "+Rcl$+".SNL "+Tmp$+"\SN_LEV.PCX >nul"
11250 SHELL "copy "+Rcl$+".IOL "+Tmp$+"\IN_OUT.PCX >nul"
11260 SHELL "copy "+Rcl$+".PIS "+Tmp$+"\P_SUP.PCX >nul"
11270 CLEAR 1: CLEAR : ON ERROR RETURN : RETURN 
